PC Answers 1995 May

home *** CD-ROM | disk | FTP | other *** search

/ PC Answers 1995 May / PC Answers CD-ROM 7 (Future Publishing) (May 1995).iso / vbits / code / cert / trk3_eg / fmdrgdrp / opt2 / invent.exe / ORDER.FRM (.txt) < prev next >

Wrap

Visual Basic Form | 1993-08-20 | 17.6 KB | 524 lines

VERSION 2.00 Begin Form OrderForm BackColor = &H00C0C0C0& Caption = "Order" ClientHeight = 4335 ClientLeft = 1560 ClientTop = 2130 ClientWidth = 5460 Height = 4740 HelpContextID = 105 Icon = ORDER.FRX:0000 Left = 1500 LinkTopic = "Form2" MaxButton = 0 'False MDIChild = -1 'True ScaleHeight = 4335 ScaleWidth = 5460 Top = 1785 Width = 5580 Begin TextBox Total BackColor = &H00808080& BorderStyle = 0 'None DataField = "Total" DataSource = "Data2" ForeColor = &H00FFFFFF& Height = 255 Left = 4320 TabIndex = 16 Top = 1020 Width = 1035 End Begin TextBox Text1 BorderStyle = 0 'None DataField = "ShipZip" DataSource = "Data2" FontBold = 0 'False FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 8.25 FontStrikethru = 0 'False FontUnderline = 0 'False Height = 255 Index = 5 Left = 2760 TabIndex = 15 Text = "Text1" Top = 1080 Width = 975 End Begin TextBox Text1 BorderStyle = 0 'None DataField = "ShipState" DataSource = "Data2" FontBold = 0 'False FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 8.25 FontStrikethru = 0 'False FontUnderline = 0 'False Height = 255 Index = 4 Left = 2220 TabIndex = 14 Text = "Text1" Top = 1080 Width = 555 End Begin TextBox Text1 BorderStyle = 0 'None DataField = "ShipCity" DataSource = "Data2" FontBold = 0 'False FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 8.25 FontStrikethru = 0 'False FontUnderline = 0 'False Height = 255 Index = 3 Left = 660 TabIndex = 13 Text = "Text1" Top = 1080 Width = 1575 End Begin TextBox Text1 BorderStyle = 0 'None DataField = "ShipAddr" DataSource = "Data2" FontBold = 0 'False FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 8.25 FontStrikethru = 0 'False FontUnderline = 0 'False Height = 495 Index = 2 Left = 660 MultiLine = -1 'True TabIndex = 12 Text = "Text1" Top = 600 Width = 3075 End Begin TextBox Text1 BackColor = &H00808000& BorderStyle = 0 'None DataField = "OrderNo" DataSource = "Data2" ForeColor = &H00FFFFFF& Height = 255 Index = 1 Left = 2820 TabIndex = 11 Text = "Text1" Top = 60 Width = 855 End Begin TextBox Text1 BorderStyle = 0 'None DataField = "CustName" DataSource = "Data2" FontBold = 0 'False FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 8.25 FontStrikethru = 0 'False FontUnderline = 0 'False Height = 255 Index = 0 Left = 660 TabIndex = 10 Text = "Text1" Top = 360 Width = 3075 End Begin Data Data2 Caption = "Data2 - Header" Connect = "" DatabaseName = "" Exclusive = 0 'False Height = 315 Left = 300 Options = 0 ReadOnly = 0 'False RecordSource = "" Top = 3780 Visible = 0 'False Width = 3375 End Begin Data Data1 Caption = "Data1 - Line Items" Connect = "" DatabaseName = "" Exclusive = 0 'False Height = 315 Left = 300 Options = 0 ReadOnly = 0 'False RecordSource = "" Top = 3360 Visible = 0 'False Width = 3375 End Begin TgDemo LineItems BackColor = &H00C0C0C0& BorderStyle = 0 'None Configurable = 0 'False DataSource = "Data1" Editable = -1 'True EditBackColor = &H8000000D& EditForeColor = &H8000000E& FetchMode = 0 'By cell HeadBackColor = &H000000C0& HeadForeColor = &H00FFFFFF& Headings = -1 'True Height = 1695 HorzColor = &H00808080& HorzLines = 2 '3D InactiveBackColor= &H00808080& InactiveForeColor= &H00000080& Layout = ORDER.FRX:0302 Left = 0 MarqueeStyle = 1 'Solid Cell Border SelectedBackColor= &H00000000& SelectedForeColor= &H00FFFFFF& SelectMode = 0 'Disabled TabIndex = 9 Top = 1440 UseBookmarks = -1 'True VertColor = &H00808080& VertLines = 2 '3D Width = 5415 End Begin TextBox Tax Alignment = 1 'Right Justify BackColor = &H00808080& BorderStyle = 0 'None ForeColor = &H00FFFFFF& Height = 255 Left = 4320 TabIndex = 4 TabStop = 0 'False Top = 720 Width = 1035 End Begin TextBox SubTot Alignment = 1 'Right Justify BackColor = &H00808080& BorderStyle = 0 'None ForeColor = &H00FFFFFF& Height = 255 Left = 4320 TabIndex = 3 TabStop = 0 'False Top = 420 Width = 1035 End Begin Label Label3 Alignment = 1 'Right Justify BackColor = &H00C0C0C0& Caption = "Order#" Height = 255 Left = 1680 TabIndex = 8 Top = 60 Width = 1035 End Begin Label Label2 Alignment = 1 'Right Justify BackColor = &H00C0C0C0& Caption = "Total:" FontBold = 0 'False FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 8.25 FontStrikethru = 0 'False FontUnderline = 0 'False Height = 255 Index = 2 Left = 3840 TabIndex = 7 Top = 1020 Width = 435 End Begin Label Label2 Alignment = 1 'Right Justify BackColor = &H00C0C0C0& Caption = "Tax:" FontBold = 0 'False FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 8.25 FontStrikethru = 0 'False FontUnderline = 0 'False Height = 255 Index = 1 Left = 3840 TabIndex = 6 Top = 720 Width = 435 End Begin Label Label2 Alignment = 1 'Right Justify BackColor = &H00C0C0C0& Caption = "Sub:" FontBold = 0 'False FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 8.25 FontStrikethru = 0 'False FontUnderline = 0 'False Height = 255 Index = 0 Left = 3840 TabIndex = 5 Top = 420 Width = 435 End Begin Label Label1 Alignment = 1 'Right Justify BackColor = &H00C0C0C0& Caption = "City:" FontBold = 0 'False FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 8.25 FontStrikethru = 0 'False FontUnderline = 0 'False Height = 255 Index = 2 Left = 0 TabIndex = 2 Top = 1080 Width = 615 End Begin Label Label1 Alignment = 1 'Right Justify BackColor = &H00C0C0C0& Caption = "Address:" FontBold = 0 'False FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 8.25 FontStrikethru = 0 'False FontUnderline = 0 'False Height = 255 Index = 1 Left = 0 TabIndex = 1 Top = 600 Width = 615 End Begin Label Label1 Alignment = 1 'Right Justify BackColor = &H00C0C0C0& Caption = "Name:" FontBold = 0 'False FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 8.25 FontStrikethru = 0 'False FontUnderline = 0 'False Height = 255 Index = 0 Left = 0 TabIndex = 0 Top = 360 Width = 615 End ' Variables local to this form instance Dim FormIndex As Integer Dim ourOrderNo As Long Dim WidthDelta As Integer Dim ourset As DynaSet Sub Data1_Validate (Action As Integer, Save As Integer) ' Recalculate the current line into the total if ' necessary If Save Then RecalcItem End If End Sub Sub Form_Deactivate () Data1.Recordset.Update End Sub Sub Form_DragDrop (Source As Control, x As Single, Y As Single) valid% = EndDragMode(MASK_NONE) End Sub Sub Form_DragOver (Source As Control, x As Single, Y As Single, State As Integer) valid% = DragValid(Source, MASK_NONE, State) End Sub Sub Form_GotFocus () SetStatus "Order form - edits line items and order header" End Sub Sub Form_Load () ' Determine the difference between internal and ' external dimensions. WidthDelta = Me.Width - Me.ScaleWidth ' Capture information stored in OpenOrder of ORDER.BAS. ' Use two data controls. Data1 is for the line items, ' Data2 is for the header ... both are stored in ' the same table and are differentiated by the ' IsDetail field. FormIndex = FormLastAlloc() Me.Tag = FormIndex fname$ = OrderFormItems(FormIndex).fiFileName tbname$ = OrderFormItems(FormIndex).fiTable Data1.DatabaseName = fname$ Data2.DatabaseName = fname$ Data1.RecordSource = "SELECT * FROM [" & tbname$ & "] WHERE OrderNo = " & RecentOrderNo & " AND IsDetail" Data2.RecordSource = "SELECT * FROM [" & tbname$ & "] WHERE OrderNo = " & RecentOrderNo & " AND NOT IsDetail" ourOrderNo = RecentOrderNo Data1.Refresh Data2.Refresh Set ourset = Data1.Recordset RecalcTable ' Set caption Me.Caption = Data2.Recordset("CustName") & " - #" & Data2.Recordset("OrderNo") End Sub Sub Form_Resize () ' Constrain our width If Me.WindowState = NORMAL Then Me.Width = LineItems.Width + WidthDelta LineItems.Height = Me.ScaleWidth - LineItems.Top End If End Sub Sub Form_Unload (Cancel As Integer) Data1.Recordset.Close Data2.Recordset.Close FormFree OrderFormItems(FormIndex) End Sub Sub LineItems_Append () ' should append a line item here End Sub Sub LineItems_DragDrop (Source As Control, x As Single, Y As Single) ' Parts can be dragged from a parts table, or from ' another order If EndDragMode(MASK_PARTS Or MASK_ORDER) Then Select Case DragType Case MASK_PARTS ourset.AddNew ourset("OrderNo") = ourOrderNo ourset("PartNo") = Source.ColumnText(1) ourset("Description") = Source.ColumnText(2) ourset("Price") = Source.ColumnText(3) ourset("Quantity") = 1 ourset("Total") = Source.ColumnText(3) ourset("IsDetail") = True ourset.Update RecalcTable ourset.MoveLast Case MASK_ORDER ourset.AddNew ourset("OrderNo") = ourOrderNo ourset("PartNo") = Source.ColumnText(1) ourset("Description") = Source.ColumnText(2) ourset("Quantity") = Source.ColumnText(3) ourset("Price") = Source.ColumnText(4) ourset("Total") = Source.ColumnText(5) ourset("IsDetail") = True ourset.Update RecalcTable ourset.MoveLast End Select End If End Sub Sub LineItems_DragOver (Source As Control, x As Single, Y As Single, State As Integer) valid% = DragValid(Source, MASK_PARTS Or MASK_ORDER, State) End Sub Sub LineItems_GotFocus () SetStatus "Editing line items - items can be dragged to other orders" End Sub Sub LineItems_KeyPress (KeyAscii As Integer) ' ESC restores the prior line item If KeyAscii = 27 Then Data1.UpdateControls End Sub Sub LineItems_KeyUp (KeyCode As Integer, Shift As Integer) ' F2 updates data to the database; DEL removes ' the line item If KeyCode = KEY_F2 Then Data1.Recordset.Update If KeyCode = KEY_DELETE And LineItems.HwndEdit = 0 And LineItems.Rows > 0 Then ourset.Delete RecalcTable ourset.MoveFirst End If End Sub Sub LineItems_LostFocus () Data1.Recordset.Update End Sub Sub LineItems_MouseDown (Button As Integer, Shift As Integer, x As Single, Y As Single) GridMaybeDrag LineItems, x, Y End Sub Sub LineItems_MouseMove (Button As Integer, Shift As Integer, x As Single, Y As Single) GridTestDrag LineItems, Button, x, Y, MASK_ORDER, Utils.DragRow End Sub Sub LineItems_Update (Row As Long, Col As Integer, Value As String) ' Calculate the extended price when the price ' or quantity is changed. fld$ = LineItems.ColumnName(Col) If fld$ = "Qty" Or fld$ = "Price" Then ' We may be at a different location than the ' one which was updated. Save our old location ' and restore it. j% = LineItems.RowIndex i% = LineItems.ColumnIndex LineItems.ColumnIndex = 5 LineItems.RowIndex = Row LineItems.Text = Format$(Val(LineItems.ColumnText(4)) * Val(LineItems.ColumnText(3)), "######0.00") LineItems.ColumnIndex = i% LineItems.RowIndex = j% End If End Sub Sub RecalcItem () ' Recalculate the total for the current item and ' update the subtotal and total in the header ' accordingly. Dim Quant As Integer Dim Price As Currency Dim oldLineTot As Currency Dim baseTotal As Currency If LineItems.ColumnChanged(3) Then Quant = LineItems.ColumnText(3) Else Quant = Data1.Recordset("Quantity") End If If LineItems.ColumnChanged(4) Then Price = LineItems.ColumnText(4) Else Price = Data1.Recordset("Price") End If oldLineTot = Data1.Recordset("Total") baseTotal = Val(SubTot.Text) - oldLineTot SetTotal baseTotal + (Price * Quant) End Sub Sub RecalcTable () Dim tot As Currency If ourset.RecordCount Then ourset.MoveFirst While Not ourset.EOF tot = tot + ourset("Total") ourset.MoveNext Wend End If SetTotal tot End Sub Sub SetTotal (t As Currency) ' Set the totals. DON'T use commas in these numbers, ' since we sometimes take the Val() of SubTot.Text. SubTot.Text = Format$(t, "######0.00") Tax.Text = Format$(t * .06, "######0.00") Total.Text = Format$(t * 1.06, "######0.00") End Sub Sub Text1_DragDrop (Index As Integer, Source As Control, x As Single, Y As Single) valid% = EndDragMode(MASK_NONE) End Sub Sub Text1_DragOver (Index As Integer, Source As Control, x As Single, Y As Single, State As Integer) valid% = DragValid(Source, MASK_NONE, State) End Sub Sub Text1_GotFocus (Index As Integer) SetStatus "Editing header fields - saved when order is closed" End Sub